perm filename FILE.3[AID,LSP]1 blob
sn#635639 filedate 1982-01-02 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 (declare (fasload util fas dsk (aid rpg)))
C00015 ENDMK
C⊗;
1#∪.≠3πK*↓#≠π≡c?π⊃π+S'1ε3πMβ'≠-↓#∞K⊃βKε9%%$hQ#∪↔≡cπK∃αCOC↔≡Kπ1↓V#↔OQαSO?W⊗≠∃↓+6K3∃↓V+cQ↓W↓↓+Cr↓+O←O#∂#↔~↓+E%αA+3↔GβI↓↔n S∂!JH4(4RC7π∂⊗{∪↔→ε33WOBk3πO"↓#31Hh)↓#f+Qβ1¬yβ30hQ↓↓↓α↓βS#.p4)↓α↓↓↓β∞ β ¬yβ1↓F≠∪∪Iεa$4)α↓↓↓↓ε#<4)α↓↓↓↓αC←#'f)β ε#<4(J↓↓↓↓αCO↔S
βπ¬↓F≠∪Iβ∞ $4(HI↓↓β⊗⊃↓#∂'⊃β JI$4)α↓↓↓↓αCKC3∞≠⊃βπ
↓!%$hQ↓↓↓α↓β1%Hh(4)F#↔≠WrβSKπw≠∪W∂*kK↔π"↓#7↔∨≠π∨∃ε#↔→7/CQ$4R↓↓↓↓α↓↓#S/∪CK%JCπ;⊃εk↔OO∞;∃↓#π∪';
εk↔OO∞;∃%↓G#g=↓≠⊃9%$hQ↓↓↓α↓↓↓#f+QβONqEα⎇αCOSπ'+MβONsSπaβ!Q9$hP%↓↓αβOg9∩α⎇↓#∨#πSW~βOg;& a↓Q2q$4(J↓↓↓β∨K9Mαz↓#OS∂#WMβ∨K;SπB↓eE9Hh(%↓α↓βOgs!α⎇↓G≠SπS/→βOgw#πa↓K→9$4PI↓↓↓π≠g9U¬y↓#O& SWMπ≠g;S∂A↓QArH4(%α↓↓βONqYα⎇αCOSπ'+MβONsSπaβ!E9$hP%↓↓αβ7π
α⎇↓#∨#πSW~β7π∂⊗y↓QQrH4(%α↓↓β7∞→Iα⎇αCOSπ'+Mβ7∞≠K=↓#19$4PI↓↓↓εkπ
M¬y↓#O& SWMεkπ∂Kz↓eE9Hh(%↓α↓β7π≠!α⎇↓G≠SπS/→β7π∨∪=↓e~q$4(J↓↓↓β&x4(%α↓↓↓#≡+SOgw#πa↓#!9↓Iβ!Q9$hP%↓↓α↓#O↔'≠g;S∂A↓QYr↓I↓Q2q$4(J↓↓↓↓G≠↔SONsSπaβIE9↓∩↓eE9Hh(%↓α↓↓#O/#Og;& a↓e~q↓I9βIM9$hP%↓↓α↓#O↔'≠g;S∂A↓QAr↓I9↓#↓9$4PI↓↓↓αCO↔S∨K;SπB↓QE9β⊃9↓Q
q$4(J↓↓↓↓Fc↔QβBα⎇↓#.s←';"kCK?&+∂QhP$%↓α↓↓↓↓G∪↔π⊃Hh($%α↓↓↓↓αCO↔S∨K;SπB↓QQ9π≠g9Eβ!Q9$hP$%↓α↓↓↓↓G≠↔SONsSπaβ!Y9β∨K9I↓#19$4PH%↓↓α↓↓↓#≡+SOgw#πa↓K 9βONqM↓e
q$4(HI↓↓↓α↓↓#O/#Og;& a↓e~qβOgs!↓eMrH4($J↓↓↓↓α↓#O↔'≠g;S∂A↓QArβOg9*↓QA9Hh($%α↓↓↓↓αCO↔S∨K;SπB↓QE9π≠g9Yβ!E9$hP$%↓α↓↓↓↓F ;⊃βn
E↓G≠OSπ'+Mβ7∞≠K=↓#!9↓#≡ Iβ7∞→E%%Hh($%α↓↓↓↓αCπ;⊃εkπ
IαCOOS∂#WMβn ∂K=β!Y9↓F≠πIβn
I%JH4($J↓↓↓↓α↓#π;"β7π
~↓#OO& SWMεkπ∂Kz↓eE9αC∂πIεkπ
MJI$4(HI↓↓↓α↓↓#πv!β7π≠!↓#O∨#πSW~β7π∂⊗y↓eMr↓#∂π∩β7π
"I%%$hP$%↓V3'3∃αS↔cQαSA↓+εq↓+O>KS∂#/→α⎇βvK1β;Naβ;'bβ;'0hP$%β&x4($J↓#∂?v!↓!#/ βa↓? W'QJ↓"{≥JH4($J↓↓↓↓α↓↓#PhP$$%Fc↔Qβ≡{WK∂*β∪↔O"α⎇↓!J↓!$4PH$%↓α↓↓↓+≡{WK∂*↓+∪↔∨!α⎇↓BI↓!$hP$$%α↓↓↓↓W≠←'S≡C↔Mαz↓!$4PH$%↓α↓↓β'wβWQαz↓#≠?∩β%→h($$HH%↓↓F+cC3}#∃βaJβO↔3.≠Q↓#v{Q↓#n+7EβJ↓≥!?b↓==↓⎇i%%%Hh($$J↓↓↓↓ε#<4(HH%↓↓α↓↓#∂}s⊃↓!Fs?Q↓B+7πS≡A↓≥!V#↔OQαz⎇↓+≡{WK∂*Iβ';π+Q%$hP$$$J↓↓↓↓G≠↔SEαSO?W⊗≠∃β'wβWQ%JI4(HH%↓↓α↓↓#?∩↓!↔7∂#∂!↓:A+O?/∪∂∃↓zA↓+O>KS∂#/→↓=%J↓+O?/∪∂∃$hP$$$J↓!↔7∂#∂!↓:A+O?/∪∂∃↓zA↓+O>KS∂#/→%↓+≡{WK∂*I$4(HH%↓↓α↓↓#O/#EβO␈+K∂∀hP$$$J↓↓↓#≡{;⊃↓@h($$HH%↓↓B+7πS≡A↓≥!V3'3∃αy9↓+/CQ↓>Z↓+A↓za$4(HH$$$J↓↓+O␈+K∂∃Hh($$HH%↓βαA#∪OZ↓!1#NkC3?&)↓+AJ↓1#∂∞#I↓#∨#πSW~βW∪'∩I%%$hP$$$HI↓↓↓αa#'7εc?∪∃αS≠'3*I1#'oβ3?∪*↓+↔c"I%%↓h($$HH%↓↓BA↔7π&≠!↓≥BS≠'3*↓=9↓V+cQ↓⎇Y↓+Aαy1↓+εq$4(HH$$$J↓↓+O␈+K∂∃Hh($$HH%↓βαA#∪OZ↓!1#NkC3?&)↓+AJ↓1#'oβ3?∪*↓+C9JH4($HH$$%αa#'7εc?∪∃αS≠'3*I1#'oβ3?∪*↓↓+↔G!%%%J↓↓↓↓h($$HH%↓!B+7πS≡A↓≥!V3'3∃αy9↓+/CQ↓>ZI↓+O␈+K∂∃Hh($$HH%↓βαA#∪OZ↓1#O& SWMπ+∪'IJH4($HH$%↓α↓↓1#NkC3?&)↓+≠Nc∃%1FK7C3}#∃↓+/CQ%%J↓4(HH$$%αA!↔7∂#∂!↓:A+≠'f)↓=9αS↔cQαzm↓+αH4($HH$$%α↓+O?/∪∂∃$hP$$$HI↓β↓BC∪O-αA1#'oβ3?∪*↓+A%αa#∂π'⊃↓#O& SWMπ+∪'IJI%$4PH$$$J↓↓↓↓bC'7Cf{∪∃↓V3'3∃Ja#'7εc?∪∃αS↔cQJI$4(hP$$$HI↓!!.kπS∂B↓≥!+6K3∃↓⎇Y↓+Aαy1$4PH$$$HI↓↓+≡{WK∂*H4($HH$%↓ε↓!#∪≡Y↓!1FK7C3}#∃↓+αI↓1#≡ ∪I↓G≠SπS/→βW∪O⊃%%%Hh($$HH%↓↓α↓1#'oβ3?∪*↓+≠'f)%βsbI$4(HH$$%αA!↔7∂#∂!↓:A+≠'f)↓>mαSA↓=b↓+C9Hh($$HH$%↓αSO?W⊗≠∃$4PH$$$J↓β↓!F#O-↓Ba#'7εc?∪∃αSA%↓bC'7Cf{∪∃↓Wβ9%%Hh($$HH%↓↓α↓1#'oβ3?∪*↓+≠'f)%βsbI%↓↓α↓4(HH$$%αA!↔7∂#∂!↓:A+≠'f)↓>mαSA$4PH$$$HI↓↓+≡{WK∂*H4($HH$%↓ε↓!#∪≡Y↓!1FK7C3}#∃↓+αI↓1#≡ ∪I↓G≠SπS/→βW∪O⊃%%%Hh($$HH%↓↓α↓1#'oβ3?∪*↓+≠'f)%βsbI$4(HH$$%αA!↔7∂#∂!↓:A+≠'f)↓>mJ↓+O?/∪∂∃$hP$$$HI↓β↓BC∪O-αa#OS∂#WMβ.#'I%Hh($$HH%↓↓α↓1#'oβ3?∪*↓+≠'f)%βsbI$4(hP$$$HI↓!!.kπS∂B↓≥!+6K3∃↓zq↓+↔G!%↓+≡{WK∂*H4($HH$%↓ε↓!#∪≡Y↓1#∨#πSW~βW∪'∩I$4(HH$$%α↓↓↓1FK7C3}#∃↓+6K3∃%bC'7Cf{∪∃↓V+cQ%JH4($HH$%↓BA↔7π&≠!↓≥BS≠'3*I↓+O␈+K∂∃Hh($$HH%↓βαA#∪OZ↓1#O& SWMπ+∪'IJH4($HH$%↓α↓↓1#NkC3?&)↓+≠Nc∃%βga%$4PH$$$J↓#QhP$$$HI↓↓#'∪π;O'+∂∃7⊗+π⊂4PH$$$J↓↓↓∨d;W↔O~βπ∨πNq¬¬πbβ∪↔→n+cQ%JI%↓hP$$%α↓↓↓hP$$%α↓↓↓↓F≠?;⊃αA+∪↔∨ 4($HH%↓↓α↓#O↔' β∪↔∨ 4($HH$%↓αC∂?;"↓ 4(HH$$$JA↔7π&≠!↓≥BS≠'3*↓=9↓V+cQ↓⎇Y↓+Aαy1$4PH$$$HH%↓+&+OQ$hP$$$HH%β↓BC∪O-αA1#'oβ3?∪*↓+A%bC∂π∪∩↓#OS∂#WMβ.#'I%JI$4(HH$$$J↓↓↓1FK7C3}#∃↓+6K3∃%bC'7Cf{∪∃↓V+cQ%JH4($HH$$%αA!↔7∂#∂!↓:A+≠'f)↓=9αS↔cQαzm↓+α↓=1↓Wβ9$4PH$$$HH%↓+&+OQ$hP$$$HH%β↓BC∪O-αA1#'oβ3?∪*↓+A%bC'7Cf{∪∃↓Wβ9%%Hh($$HH$%↓α↓1#'oβ3?∪*↓+≠'f)%1#NkC3?&)↓↓+/CQ%%J↓↓↓↓h($$HH$%!B+7πS≡A↓≥!V3'3∃αy9↓+/CQ↓>ZI↓+∪/≠Q$4PH$$$HIβ↓!F#O-↓bCOSπ'+MβW&KI%$hP$$$HH%↓↓αa#'7εc?∪∃αS≠'3*I1#'oβ3?∪*↓+↔c"I%$4PH$$$HI!!↔n S∂!α9!+≠Nc∃↓=r↓+↔c"↓>m↓W↓$4(HH$$$HI↓+∪/≠Q$4PH$$$HIβ↓!F#O-↓Ba#'7εc?∪∃αSA%↓bC∂π∪∩↓#OS∂#WMβ.#'I%JI$4(HH$$$J↓↓↓1FK7C3}#∃↓+6K3∃%bC'7Cf{∪∃↓V+cQ%JH4($HH$$$hP$$$HH%!!.kπS∂B↓≥!+6K3∃↓⎇Y↓+Aαy1$4PH$$$HH%↓+&+OQ$hP$$$HH%β↓BC∪O-αA1#'oβ3?∪*↓+A%bC∂π∪∩↓#OS∂#WMβ.#'I%JI$4(HH$$$J↓↓↓1FK7C3}#∃↓+6K3∃%πcq%$hP$$$HH%!!.kπS∂B-Kf'(*file /[ *p /, *pn)
*dest)
`((dsk (,(implode *p),(implode *pn)))
,(implode *file) ||))
((%match '(*file /[ *p)
*dest)
`((dsk (,(implode *p),(cadr (status udir))))
,(implode *file) ||))
((%match '(*file /[) *dest)
`((dsk ,(status udir))
,(implode *file) ||))
((%match '(*file /. *ext) *dest)
`(,(car source)
,(implode *file),(implode *ext)))
((%match '(*file) *dest)
`(,(car source)
,(implode *file) ,def-ext))
(t
(transduce-read
'|Guess again!!!| def-ext)))) )
(t (setq dest (subst () () source))
(and (cddr dest) (rplaca (cddr dest) def-ext))))
(list dest source *switches)))))))
(defun read-filename (message)
(and message (terpri))
(and message (princ message)(tyo 32.))
(let syn1 ← (status syntax 44.)
syn2 ← (status syntax 46.)
syn3 ← (status syntax 91.)
syn4 ← (status syntax 93.)
syn5 ← (status syntax 40.)
syn6 ← (status syntax 41.)
mac1 ← (status macro 44.)
mac2 ← (status macro 46.)
mac3 ← (status macro 91.)
mac4 ← (status macro 93.)
do
(setsyntax 44. 2 44.)
(setsyntax 46. 2 46.)
(setsyntax 91. 2 91.)
(setsyntax 93. 2. 93.)
(setsyntax 40. 2 40.)
(setsyntax 41. 2 41.)
(let x ← (unwind-protect
(read)
(setsyntax 44. syn1 44.)
(setsyntax 46. syn2 46.)
(setsyntax 91. syn3 91.)
(setsyntax 93. syn4 93.)
(setsyntax 40. syn5 40.)
(setsyntax 41. syn6 41.)
(and mac1 (sstatus macro 44. (car mac1)))
(and mac2 (sstatus macro 46. (car mac2)))
(and mac3 (sstatus macro 91. (car mac3)))
(and mac4 (sstatus macro 93. (car mac4))))
*file *ext *p *pn *switches ← nil nil nil nil nil
filespec ← nil
do
(cond ((eq x 'quit) (↑g))
(t (let *q ← (for i ε
(explode x) select (not (memq i '(/| // /]))))
do
(or
(%match '(*q /( *switches /)) *q)
(%match '(*q /( *switches ) *q))
(setq filespec
(cond (
(%match '(*file /. *ext /[ *p /,)
*q)
`((dsk (,(implode *p) ,(cadr (status udir))))
,(implode *file),(implode *ext)))
((%match '(*file /. *ext /[ *p /, *pn)
*q)
`((dsk (,(implode *p) ,(implode *pn)))
,(implode *file),(implode *ext)))
((%match '(*file /. *ext /[) *q)
`((dsk ,(status udir))
,(implode *file),(implode *ext)))
((%match '(*file /. *ext /[ *p)
*q)
`((dsk (,(implode *p),(cadr (status udir))))
,(implode *file),(implode *ext)))
((%match '(*file /[ *p /,)
*q)
`((dsk (,(implode *p),(cadr (status udir))))
,(implode *file) ||))
((%match '(*file /[ *p /, *pn)
*q)
`((dsk (,(implode *p),(implode *pn)))
,(implode *file),(implode *ext)))
((%match '(*file /[ *p)
*q)
`((dsk (,(implode *p) ,(cadr (status udir))))
,(implode *file) ||))
((%match '(*file /[) *q)
`((dsk ,(status udir))
,(implode *file) ||))
((%match '(*file /. *ext) *q)
`((dsk ,(status udir))
,(implode *file),(implode *ext)))
((%match '(*file) *q)
x)
(t
(read-filename
'|Guess again!!!|))))
`(,filespec ,*switches))))))))